          SUBROUTINE (PASSER)
** Version# 113.0002[27] - 11/16/2017 - 11:25am - TSMITH - eclipse
*** V113.0002 Change - Custom Coding . - 11/16/2017 - TSMITH - eclipse
** Copied from BP PUR.RETURN.GOODS Version# 113 - 06/21/2012 - 04:02pm - JIMK - main
*** Subroutine: PUR.RETURN.GOODS
*-------------------------------------------------------------------------*
*** This routine displays the Purchase Return Goods Queue, that purchasing
*** uses to maintain the return of parts that were returned to them, are
*** defective, or overshipped from the vendor (products they did not ask
*** for). They can either return the items to a vendor or to another
*** branch to consoidate goods and return them all at once to the vendor.
*-------------------------------------------------------------------------*
*** PASSER - None
*-------------------------------------------------------------------------*
*** COMMON VARIABLES : LED, OLED, LD, OLD.LD are all used when we create
*** the return order (Calling OE.CREATE.LEDGER)
*-------------------------------------------------------------------------*
          DIM TEMP.LED(200)

          SCREEN

          VSCROLL.DEFINE 1,1,3,78,15,'PUR.RETURN.GOODS'
          VSCROLL.SET 1

          CHECK.KEY 'INVADJ.ALLOWED',ENTRY.OK,LEVEL
          IF ENTRY.OK AND LEVEL>1 THEN ADJ.OK = YES ELSE ADJ.OK = NO

          *** Open the file that holds vendor assignments.
          *** The ID to this file is "OID.PN.LDID".  The body of this
          *** file is: ROQ<1> = VN
          UT.OPEN.FILE 'RET.ORDER.QUEUE',ROQFILE,FILE.ERROR,YES
          IF FILE.ERROR THEN
             EXECUTE "CREATE-FILE RET.ORDER.QUEUE 1 101,1,18" CAPTURING MSG
             UT.OPEN.FILE 'RET.ORDER.QUEUE',ROQFILE,FILE.ERROR
             IF FILE.ERROR THEN PRINT BELL:; RETURN
          END

          IF JOHNSTONE.SITE$ THEN
             UT.OPEN.FILE 'JS.WARRANTY',JSWARFILE,JSOPNERR,YES
             IF JSOPNERR THEN JS.OPT = NO ELSE JS.OPT = YES
          END ELSE
             JS.OPT = NO
          END

          *** check if need to update cost on PO from Tagged Return SO
          *** in Return Goods Queue
          READ UPDATE.RETURN.COST FROM CTRLFILE,'RETURN.GOODS.COST' ELSE
             UPDATE.RETURN.COST = NO
          END

          *** Append return comments to desc if system is set up to do so
          READV RET.CMTS FROM CTRLFILE,'ADD.RETURN.CMT.TO.QUEUE',1 ELSE
             RET.CMTS=''
          END

          *** Default select by Buy Line or Price Line
          VALID.DSLCTS = 'Buy Line':VM:'Price Line'
          READ DSLCT FROM CTRLFILE,'RTN.QUEUE.SELECT' ELSE DSLCT = ''
          IF DSLCT # 'Price Line' THEN DSLCT = 'Buy Line'

          VALID.TYPES = 'O':VM:'F':VM:'R'
          WCT      = 1
          CSORT    = 1
          DESC.LN  = 1
          COMM.LN  = 1
          DSP.CODE = 1
          ADJUST   = NO
*-------------------------------------------------------------------------*
START:    CLEAR.SCREEN
          PRINT @(21,1):(DSLCT 'L#10'):

          TYPES  = ''
          RBR    = ''
          BLINE  = ''
          PLINE  = ''
          BUYER  = ''
          IDS    = ''
          ID     = ''
          VN     = ''
          SV.IDS = ''
          SV.VEN = ''
          VN.CHG = NO
          VIEW   = 1
          BOC    = 1
          NETS   = ''
*-------------------------------------------------------------------------*
IN.BR:    INP.BR 11,1,9,PO.BR
          IF QUIT THEN GOTO FINISH
          IF PO.BR = '' THEN PRINT BELL:; GOTO IN.BR

          IF DSLCT = 'Price Line' THEN
             ON MOVE+1 GOTO IN.BR,IN.BR,IN.BR,IN.PLINE,IN.PLINE,IN.PLINE,IN.PLINE
          END ELSE
             ON MOVE+1 GOTO IN.BR,IN.BR,IN.BR,IN.BLINE,IN.BLINE,IN.BLINE,IN.BLINE
          END
*-------------------------------------------------------------------------*
IN.DSLCT: INP DSLCT,21,1,10,V_'D:':VALID.DSLCTS
          IF QUIT THEN GOTO FINISH
          IF DSLCT = 'Price Line' THEN
             ON MOVE+1 GOTO IN.DSLCT,IN.BR,IN.DSLCT,IN.PLINE,IN.PLINE,IN.PLINE
          END ELSE
             ON MOVE+1 GOTO IN.DSLCT,IN.BR,IN.DSLCT,IN.BLINE,IN.BLINE,IN.BLINE
          END
*-------------------------------------------------------------------------*
IN.PLINE: INP PLINE,34,1,10,'MCU',V_'PRICE.LINE'
          IF QUIT THEN GOTO FINISH
          IF PLINE#'' AND BUYER#'' THEN BUYER=''; PRINT @(54,1):SPACE(9):
          ON MOVE+1 GOTO IN.PLINE,IN.DSLCT,IN.PLINE,IN.BUY,IN.BUY,IN.BUY
*-------------------------------------------------------------------------*
IN.BLINE: INP BLINE,34,1,10,'MCU',V_'S:VERF.BLNE.ID'
          IF QUIT THEN GOTO FINISH
          IF BLINE#'' AND BUYER#'' THEN BUYER=''; PRINT @(54,1):SPACE(9):
          ON MOVE+1 GOTO IN.BLINE,IN.DSLCT,IN.BLINE,IN.BUY,IN.BUY,IN.BUY
*-------------------------------------------------------------------------*
IN.BUY:   INP BUYER,54,1,9,V_'INITIALS'
          IF QUIT THEN GOTO FINISH
          IF BUYER # '' THEN
             PRINT @(34,1):SPACE(10):
             PLINE = ''
             BLINE = ''
          END
          IF DSLCT = 'Price Line' THEN
             ON MOVE+1 GOTO IN.BUY,IN.PLINE,IN.BUY,IN.TYP,IN.TYP
          END ELSE
             ON MOVE+1 GOTO IN.BUY,IN.BLINE,IN.BUY,IN.TYP,IN.TYP
          END
*-------------------------------------------------------------------------*
IN.TYP:   INP TYPES,73,1,5,'MCU'
          IF QUIT THEN GOTO FINISH
          ON MOVE+1 GOTO IN.TYP,IN.BUY,IN.TYP,IN.TYP
*-------------------------------------------------------------------------*
RESTART:  IF TYPES = '' THEN TYPES = VALID.TYPES ELSE
             CONVERT ' ' TO '' IN TYPES
             CONVERT ',' TO VM IN TYPES
             TYP.CT = DCOUNT(TYPES,VM)
             FOR T = 1 TO TYP.CT
                LOCATE TYPES<1,T> IN VALID.TYPES<1> SETTING POS ELSE
                   MESS 20,10,BELL:'Invalid type'
                   GOTO IN.TYP
                END
             NEXT T
          END
          GOSUB SEL.IDS

          IF LN.CT = 0 THEN
             MESS 20,10,BELL:'No Items Found'
             GOTO START
          END

          GOSUB LOAD.HOTKEYS

          COL = 1; LINE = 1; COLS = 1; DNOK = YES; MOVE = 0; LASTKEY=0
*-------------------------------------------------------------------------*
MOVENEXT: IF QUIT THEN GOSUB SAVE.VNS
          LASTLINE=LINE
          PARSEMOVE COL,LINE,COLS,LN.CT,15,DNOK
          IF SKIPLN<LINE> THEN
             DEF    = VSCROLL.DEF.<WINDOW.LEVEL,1>
             OFFSET = DEF<1,1,1>+DEF<1,1,6>
             IF LINE > OFFSET THEN
                VSCROLL LINE - OFFSET
             END
             IF LINE-LASTLINE>0 THEN MOVE=4 ELSE MOVE=2
             IF LINE=LN.CT THEN MOVE=2
             GOTO MOVENEXT
          END
*-------------------------------------------------------------------------*
INP.VN:   BEGIN CASE
          CASE VIEW = 1
IN$$11:      INPV VEN,60,LINE,18
             IF CHANGED THEN
                VN.CHG = YES
                IF VEN = '' THEN VN = '' ELSE
                   FINDID VN,VEN,'VENDOR','TENTITY;X;9;9',20,7,5,35,'SEL.ENT.POE','&INDEX&.SF',PO.BR
                   IF VN = '' THEN
                      LN = LINE
                      GOSUB DISP.VN
                      GOTO INP.VN
                   END
                END
                VNS<LINE> = VN
                LN        = LINE
                GOSUB DISP.VN
             END
          CASE VIEW = 3
IN$$15:      INPV VEN,77,LINE,1
          IF CHANGED THEN
                VN.CHG = YES
                IF VEN = '' THEN VN = '' ELSE
                   FINDID VN,VEN,'VENDOR','TENTITY;X;9;9',20,7,5,35,'SEL.ENT.POE','&INDEX&.SF',PO.BR
                   IF VN = '' THEN
                      LN = LINE
                      GOSUB DISP.VN
                      GOTO INP.VN
                   END
                END
                VNS<LINE> = VN
                LN        = LINE
                GOSUB DISP.VN
             END
          CASE OTHERWISE
IN$$12:      INPV VEN,62,LINE,16
             IF CHANGED THEN
                VN.CHG = YES
                IF VEN = '' THEN VN = '' ELSE
                   FINDID VN,VEN,'VENDOR','TENTITY;X;9;9',20,7,5,35,'SEL.ENT.POE','&INDEX&.SF',PO.BR
                   IF VN = '' THEN
                      LN = LINE
                      GOSUB DISP.VN
                      GOTO INP.VN
                   END
                END
                VNS<LINE> = VN
                LN        = LINE
                GOSUB DISP.VN
             END
          END CASE
          GOTO MOVENEXT
*-------------------------------------------------------------------------*
SEL.IDS:  WINDOW.CHILD 20,1,40,1,3
          PRINT @(21,1):BLINK$:'Selecting... Press <Enter> to Halt...':NORM$
          PRINT HOLDOFF$

          BEGIN CASE
          CASE BUYER
             SELECT BLNEFILE
             SELS=''
             LOOP
                READNEXT ID ELSE EXIT
                * Exclude Super Buylines
                READV BUYLINE.IDS FROM BLNEFILE,ID,4 ELSE BUYLINE.IDS = ''
                IF TRIM(BUYLINE.IDS) THEN CONTINUE

                * Changed the code so that it would read the
                * buyline br.spec.
                BUYLINE.BR.GET.VAL PO.BR,ID,17,BLNE.BUYER
                IF BLNE.BUYER=BUYER THEN
                   GET.BLINE.IDS ,SEL.PNS,ID
                   CONVERT VM TO AM IN SEL.PNS
                   SELS<-1>=SEL.PNS
                END
             REPEAT
             SELECT SELS
          CASE DSLCT = 'Buy Line' AND BLINE # ''
             GET.BLINE.IDS ,SEL.PNS,BLINE
             CONVERT VM TO AM IN SEL.PNS
             SELECT SEL.PNS
          CASE DSLCT = 'Price Line' AND PLINE # ''
             GET.LINE.IDS ,SEL.PNS,PLINE
             CONVERT VM TO AM IN SEL.PNS
             SELECT SEL.PNS
          CASE OTHERWISE
             PRDD.PN.SELECT
          END CASE

          IDS      = ''
          PNS      = ''
          VNS      = ''
          COMMENT  = ''
          RCOM     = ''
          RPER     = ''
          TREM     = ''
          SKIPLN   = ''
          RQTYS    = ''
          SORTBYS  = ''
          OLD.LOCS = ''
          OIDS     = ''
          GENS     = ''
          LN.CT    = 0
          VCLR 1
          LOOP
             READNEXT PN ELSE EXIT

IN$$3:       INPUT X,-1
             IF X THEN
IN$$8:          INPUTCLEAR
                EXIT
             END

             PRDD.BR.GET.REC PO.BR,PN,PRDX
             IF PRDX<1>#'' OR PRDX<2>#'' THEN
                GOSUB FIX.DISP
             END
          REPEAT

          WINDOW.CHILD.CLOSE

          RETURN
*-------------------------------------------------------------------------*
GET.NEW:  NEW.LOCS  = ''
          NEW.QTYS  = ''
          OPEN.LOCS = ''
          CLSD.LOCS = ''
          IN.PROCESS = ''

          READV COMP.PNS FROM PRDFILE,PN,53  ELSE COMP.PNS = 'X'
          READV DYN.KIT  FROM PRDFILE,PN,106 ELSE DYN.KIT  = NO
          IF TRIM(COMP.PNS,VM) # '' AND NOT(DYN.KIT) THEN RETURN
          PRDD.BR.GET PO.BR,PN

          *** Add all Location Entries
          LCT = DCOUNT(PRDD.BR(8),VM)
          FOR J = 1 TO LCT
             IN.PROC = NO
             LOC   = PRDD.BR(8)<1,J>
             LOCATE FIELD(LOC,'~',1) IN TYPES<1> SETTING POS THEN
                IF FIELD(LOC,'~',1) = 'R' AND PRDD.BR(31)<1,J,1> = 'C' THEN CONTINUE
                * Do not add if this is in-process. We know its in-process
                * if there is something in the 4th field of the LOC.CODE
                * value. Recall that LOC.CODE (PROD.DYNAM(8)) is multi
                * valued and parallel to QTY (PROD.DYNAM(1))
                * to
                !IF FIELD(LOC,'~',4) # '' THEN CONTINUE

                *The line above was commented because the continue will
                *mess up the NEW.LOCS and NEW.QTYS array. Inprocess QTY
                *will not cancel out non-inprocess QTY causing the
                *returns with in-process POs to show up in the queue
                *IN.PROCESS was added to make sure that when this loop is
                *done and there exists IN-PROCESS item in NEW.LOCS, it'll be
                *removed.

                IF FIELD(LOC,'~',4) # '' THEN
                   IN.PROC = YES
                END ELSE
                   IN.PROC = NO
                END
                TAG = FIELD(LOC,'~',3)
                IF DCOUNT(TAG,'^')=2 THEN
                   TAG = FIELD(TAG,'^',2)
                END
                TAG  = FIELD(TAG,'.',1):'~':FIELD(TAG,'.',2)
                RID  = FIELD(LOC,'~',1,2):'~':TAG
                RQTY = -PRDD.BR(1)<1,J>
                GOSUB ADD.ONE
                *** Create list of all Closed Orders when selecting Closed
                IF BOC = 3 THEN
                   LOCATE RID IN CLSD.LOCS SETTING CPOS ELSE
                      CTST.TAG = FIELD(RID,'~',3,2)
                      FINDSTR CTST.TAG IN CLSD.LOCS SETTING CPOS ELSE
                         CLSD.LOCS<CPOS> = RID
                      END
                   END
                END
             END
          NEXT J
          NEW.LOCS.CT = DCOUNT(NEW.LOCS,AM)
          FOR I = NEW.LOCS.CT TO 1 STEP -1
             IF IN.PROCESS<I> THEN
                 NEW.LOCS = DELETE(NEW.LOCS,I)
                 NEW.QTYS = DELETE(NEW.QTYS,I)
                 IN.PROCESS = DELETE(IN.PROCESS,I)
             END
          NEXT I
          IN.PROC = NO
          ** Add all Open Qtys
          LCT = DCOUNT(PRDD.BR(2),VM)
          FOR J = 1 TO LCT
             PID = PRDD.BR(2)<1,J>
             LOCATE FIELD(PID,'~',6) IN TYPES<1> SETTING POS THEN
                IF FIELD(PID,'~',6) = 'R' AND PRDD.BR(31)<1,J,1> = 'C' THEN CONTINUE
                *** Don't count a transfer until it's received...
                ORIG.OID = FIELD(PID,'~',3)
                ORD.STAT = FIELD(PID,'~',9)
                IF ORIG.OID[1,1] = 'T' AND ORD.STAT = 'O' THEN
                   READ TLED FROM LEDFILE,ORIG.OID THEN
                      IF TLED<2,2,2> = PO.BR AND TLED<6,2> # 'R' THEN
                         CONTINUE
                      END
                   END
                END
                TAG = FIELD(FIELD(PID,'~',7),'^',2)
                IF TAG = '' THEN
                   RID = FIELD(PID,'~',6):'~~':FIELD(PID,'~',3,2)
                END ELSE
                   TAG = FIELD(TAG,'.',1):'~':FIELD(TAG,'.',2)
                   LOC = FIELD(FIELD(PID,'~',7),'^',1)
                   RID = FIELD(PID,'~',6):'~':LOC:'~':TAG
                END
                RQTY = -PRDD.BR(3)<1,J>
                GOSUB ADD.ONE
                *** Create list of all Open Orders when selecting Open
                IF BOC = 2 THEN
                   LOCATE RID IN OPEN.LOCS SETTING OPOS ELSE
                      OTST.TAG = FIELD(RID,'~',3,2)
                      FINDSTR OTST.TAG IN OPEN.LOCS SETTING OPOS ELSE
                         OPEN.LOCS<OPOS> = RID
                      END
                   END
                END
             END
          NEXT J

          NEW.LOC.CT = DCOUNT(NEW.LOCS,AM)
          BEGIN CASE
          CASE BOC = 2               ; * Open Orders Only
             *** Delete from list of NEW.LOCS if not in the Open list also
             FOR NCTR = NEW.LOC.CT TO 1 STEP -1
                LOCATE NEW.LOCS<NCTR> IN OPEN.LOCS SETTING XPOS ELSE
                   NEW.LOCS = DELETE(NEW.LOCS,NCTR)
                   NEW.QTYS = DELETE(NEW.QTYS,NCTR)
                END
             NEXT NCTR
          CASE BOC = 3               ; * Closed Orders Only
             *** Delete from list of NEW.LOCS if not in the Clsd list also
             FOR NCTR = NEW.LOC.CT TO 1 STEP -1
                LOCATE NEW.LOCS<NCTR> IN CLSD.LOCS SETTING XPOS ELSE
                   NEW.LOCS = DELETE(NEW.LOCS,NCTR)
                   NEW.QTYS = DELETE(NEW.QTYS,NCTR)
                END
             NEXT NCTR
          END CASE

          RETURN
*-------------------------------------------------------------------------*
ADD.ONE:  *
          LOCATE RID IN NEW.LOCS SETTING POS ELSE
             * When returning lots we want to force a separate line for
             * each item/lot combination both to display in the queue and
             * when added to the return PO.  The following lines will
             * serve that purpose.  Adding the lot# to the end of the
             * TST.TAG string will ensure that that particular order/item
             * and lot# combination will not be located in the NEW.LOCS
             * variable and therefore cause a separate entry for that
             * item/lot# combination.
             TST.LOC = FIELD(RID,'~',2)
             TST.LOT = TRIM(FIELD(TST.LOC,'|',2))
             TST.TAG = FIELD(RID,'~',3,2)
             IF TST.LOT THEN
                TST.TAG = TST.TAG:'|':TST.LOT
             END

             *** Make sure tags offset each other
             FINDSTR TST.TAG IN NEW.LOCS SETTING POS ELSE
                NEW.LOCS<POS> = RID
                IN.PROCESS<POS> = IN.PROC
             END
          END
          NEW.QTYS<POS> += RQTY
          IF NEW.QTYS<POS>+0 = 0 THEN
             NEW.LOCS = DELETE(NEW.LOCS,POS)
             NEW.QTYS = DELETE(NEW.QTYS,POS)
             IN.PROCESS = DELETE(IN.PROCESS,POS)
          END
          RETURN
*-------------------------------------------------------------------------*
GET.OLD:  * FIND ALL OCCURRENCES OF PN
          OCCUR = 1
          OLD.LOCS = ''
          LOOP
             LOCATE PN IN PNS,OCCUR SETTING LN ELSE EXIT
             OLD.LOCS = INSERT(OLD.LOCS,-1;IDS<LN>)
             OCCUR    = LN + 1
          REPEAT
          RETURN
*-------------------------------------------------------------------------*
DISP.LN:  *

          MATREAD PRD FROM PRDFILE,PN ELSE MAT PRD = ''
          DESC = PRD(1)
          ID    := '~':PN
          OID  = FIELD(ID,'~',3)
          LDID = FIELD(ID,'~',4)
          GID  = FIELD(ID,'~',5)
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
          *** If order invoiced, then GID will be null
          *** Find GEN using OID and LDID
          IF GID = PN THEN
             GEN.CT = DCOUNT(LED(48)<1>,VM)
             GEN    = 1
             FOR GN = 1 TO GEN.CT
                LOCATE LDID IN LED(48)<1,GN> SETTING NADA THEN
                   GEN = GN
                   IF LED(6)<1,GEN> = 'X' THEN CONTINUE ELSE EXIT
                END ELSE CONTINUE
             NEXT GN
          END ELSE
             LOCATE GID IN LED(12)<1> SETTING GEN ELSE GEN = 1
          END
          OSTAT =  LED(6)<1,GEN>
          IF OSTAT = 'X' THEN RETURN
          IF LED(8)<1,GEN> = '' THEN
             ORN = OID:'.':LED(12)<1,GEN>'R%4'
          END ELSE
             ORN = OID:'.':LED(8)<1,GEN>"R%3"
          END
          LOCATE ID IN IDS SETTING LN ELSE
             PSORT = PRD(9)
             GET.LINE.IDS ,L,PSORT
             LOCATE PN IN L<1> SETTING SEQ ELSE SEQ = ''
             IF SEQ = '' THEN SEQ = PN
             SEQ = SEQ "R%6"

             LD.GET LDID

       *** Sort by Buyline, Return Code, Sales Order Number, or Ship Date
             BEGIN CASE
             CASE CSORT = 1
                SORTBY = PRD(12):PRD(9):SEQ:OID
             CASE CSORT = 2
                *** Sort by reason code.  If NULL then put later in list
                RTEMP =  LD(46)<1>
                IF RTEMP = '' THEN RTEMP = 'ZZZZZZ'
                SORTBY = RTEMP:PRD(9):SEQ:OID
             CASE CSORT = 3
                SORTBY = OID:PRD(12):PRD(9):SEQ
             CASE CSORT = 4
                SHIP.DATE = LED(9)<1,GEN>
                SORTBY = SHIP.DATE:OID:PRD(12):PRD(9):SEQ
             END CASE
             LOCATE SORTBY IN SORTBYS BY 'AL' SETTING LN ELSE NULL
             SORTBYS = INSERT(SORTBYS,LN;SORTBY)
             IDS     = INSERT(IDS,LN;ID)
             LOCATE ID IN SV.IDS SETTING VPOS THEN
                VNS  = INSERT(VNS,LN;SV.VEN<VPOS>)
             END ELSE
                VNS  = INSERT(VNS,LN;'')
             END
             *** If there's no vendor yet assigned, check to see if there
             *** is an assignment saved.
             IF NOT(VNS<LN>) THEN
                ROQID = OID:'.':PN:'.':LDID
                READV ROQVN FROM ROQFILE,ROQID,1 ELSE ROQVN = ''
                VNS<LN> = ROQVN
             END
             RQTYS   = INSERT(RQTYS,LN;QTY)
             PNS     = INSERT(PNS,LN;PN)
             SKIPLN  = INSERT(SKIPLN,LN;NO)
             COMMENT = INSERT(COMMENT,LN;'')
             RCOM    = INSERT(RCOM,LN;'')
             RPER    = INSERT(RPER,LN;'')
             TREM    = INSERT(TREM,LN;'')
             OIDS    = INSERT(OIDS,LN;OID)
             GENS    = INSERT(GENS,LN;GEN)
             LN.CT  += 1
             VINS LN
          END

          GOSUB CLEAN.CMTS

          COMMENT<LN> = CLEAN.CMTS
          RCOM<LN>    = LD(46)<1>
          RPER<LN>    = LD(58)<1>
          TREM<LN>    = LD(68)<1>

          ** Look at the product first for the UM.  If not there,
          ** go to the priceline JAMESV 10/13/98
          IF PRD(15) = '' THEN
             READV UM.TBL FROM PLNEFILE,PRD(9),3 ELSE UM.TBL = ''
          END ELSE
             UM.TBL = PRD(15)
          END
          IQ.TO.ALPHA UM.TBL,PRD(7),LD(23),RQTYS<LN>,Q1,U1,Q2,U2,QO.ALPHA
          BEGIN CASE
          CASE VIEW = 1
             VPRINT 0,LN,OID                              "L#10"
             VPRINT 11,LN,QO.ALPHA                        "R#12"
             VPRINT 24,LN,FIELD(ID,'~',1)                 "L#1"
             VPRINT 26,LN,DESC<1,1>                       "L#33"

             GOSUB DISP.VN
             CT=1
             TEST = DESC.LN
             TEMP = DESC
             GOSUB PRT.LN
             CT=0
             TEST = COMM.LN
             TEMP = CLEAN.CMTS
             GOSUB PRT.LN

             *** Display Return code
             IF DSP.CODE AND LD(46)<1> # '' THEN
                CT=0
                TEST = 1
                TEMP = '** Return Code: ':LD(46)<1>
                GOSUB PRT.LN
             END
          CASE VIEW = 2
             STR = DESC
             CONVERT VM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.DESC,VCT

             STR = CLEAN.CMTS
             CONVERT VM TO ' ' IN STR
             CONVERT SVM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.COMMENT,VCT

             SHIP.DATE = LED(9)<1,GEN>
             CONV.SHIP.DATE = OCONV(SHIP.DATE,'D2/')

             VPRINT 0, LN,ORN                             "L#14"
             VPRINT 15,LN,QO.ALPHA                        "R#12"
             VPRINT 28,LN,FIELD(ID,'~',1)                 "L#1"
             VPRINT 30,LN,NEW.DESC<1,1>                   "L#22"
             VPRINT 53,LN,CONV.SHIP.DATE                  "L#8"

             GOSUB DISP.VN
             CT = 1
             TEST = DESC.LN
             TEMP = NEW.DESC
             GOSUB PRT.LN
             CT = 0
             TEST = COMM.LN
             TEMP = NEW.COMMENT
             GOSUB PRT.LN

             *** Display Return code
             IF DSP.CODE AND LD(46)<1> # '' THEN
                CT=0
                STR = '** Ret Code: ':LD(46)<1>
                STR = TRIM(STR)
                FOLD STR,16,NEW.RETURN.CODE,VCT
                TEST = 1
                TEMP = NEW.RETURN.CODE
                GOSUB PRT.LN
             END
          CASE VIEW = 4
             STR = DESC
             CONVERT VM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.DESC,VCT

             STR = CLEAN.CMTS
             CONVERT VM TO ' ' IN STR
             CONVERT SVM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.COMMENT,VCT

             SHIP.BR = LED(2)<1,GEN,2>

             * Check if cost on order is lower or equal to Non Economic
             * amt.  If <= then display YES e.g. it is not economic to
             * return this product
             ECON.COST = OCONV(LD(10)<1,GEN>,'MR29')

             * Check product level first then price line
             * Print Yes if product is econonmic to return and No
             *
             PRD.BR.GET.VAL SHIP.BR,PN,63,ECON.AMT
             IF NOT(ECON.AMT) THEN
                PLNE.BR.GET.VAL SHIP.BR,PRD(9),14,ECON.AMT
             END
             ECONINFO = SPACE(3):'Yes'
             IF ECON.AMT THEN
                ECON.AMT = OCONV(ECON.AMT,'MR0')
                IF ECON.COST <= ECON.AMT THEN
                   ECONINFO = SPACE(3):'No'
                END
             END
             VPRINT 0, LN,ORN                             "L#14"
             VPRINT 15,LN,QO.ALPHA                        "R#12"
             VPRINT 28,LN,FIELD(ID,'~',1)                 "L#1"
             VPRINT 30,LN,NEW.DESC<1,1>                   "L#22"
             VPRINT 53,LN,ECONINFO                      "L#8"

             GOSUB DISP.VN

             CT = 1
             TEST = DESC.LN
             TEMP = NEW.DESC
             GOSUB PRT.LN
             CT = 0
             TEST = COMM.LN
             TEMP = NEW.COMMENT
             GOSUB PRT.LN

             *** Display Return code
             IF DSP.CODE AND LD(46)<1> # '' THEN
                CT=0
                STR = '** Ret Code: ':LD(46)<1>
                STR = TRIM(STR)
                FOLD STR,16,NEW.RETURN.CODE,VCT
                TEST = 1
                TEMP = NEW.RETURN.CODE
                GOSUB PRT.LN
             END
          CASE VIEW = 5
             STR = DESC
             CONVERT VM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.DESC,VCT

             STR = CLEAN.CMTS
             CONVERT VM TO ' ' IN STR
             CONVERT SVM TO ' ' IN STR
             STR = TRIM(STR)
             FOLD STR,22,NEW.COMMENT,VCT

             SHIP.BR = LED(2)<1,GEN,2>

             * Check if cost on order is lower or equal to Non Economic
             * amt.  If <= then display YES e.g. it is not economic to
             * return this product
             ECON.COST = OCONV(LD(10)<1,GEN>,'MR29')

             * Check product level first then price line
             * Print Yes if product is econonmic to return and No
             *
             PRD.BR.GET.VAL SHIP.BR,PN,63,ECON.AMT
             IF NOT(ECON.AMT) THEN
                PLNE.BR.GET.VAL SHIP.BR,PRD(9),14,ECON.AMT
             END
             ECONINFO = SPACE(3):'Yes'
             IF ECON.AMT THEN
                ECON.AMT = OCONV(ECON.AMT,'MR0')
                IF ECON.COST <= ECON.AMT THEN
                   ECONINFO = SPACE(3):'No'
                END
             END
             VPRINT 0, LN,ORN                             "L#14"
             VPRINT 15,LN,QO.ALPHA                        "R#12"
             VPRINT 28,LN,FIELD(ID,'~',1)                 "L#1"
             VPRINT 30,LN,NEW.DESC<1,1>                   "L#22"
             VPRINT 53,LN,ECONINFO                      "L#8"
             WAR.ID = OID:'.':LDID
             READV JS.WAR.TAG FROM JSWARFILE,WAR.ID,1 ELSE JS.WAR.TAG = ''

             VPRINT 62,LN,JS.WAR.TAG "L#16"

             CT = 1
             TEST = DESC.LN
             TEMP = NEW.DESC
             GOSUB PRT.LN
             CT = 0
             TEST = COMM.LN
             TEMP = NEW.COMMENT
             GOSUB PRT.LN

             *** Display Return code
             IF DSP.CODE AND LD(46)<1> # '' THEN
                CT=0
                STR = '** Ret Code: ':LD(46)<1>
                STR = TRIM(STR)
                FOLD STR,16,NEW.RETURN.CODE,VCT
                TEST = 1
                TEMP = NEW.RETURN.CODE
                GOSUB PRT.LN
             END
          CASE OTHERWISE
             PO.NUM   = LED(13)<1,GEN>
             NAME   = TRANS('ENTITY',LED(5)<1,GEN>,1,'X')<1,1,1>
             IF NAME = "" THEN NAME = "GP SUPPLY COMPANY"
             RET.CODE = LD(46)<1>
             IF NOT(RET.CODE) THEN RET.CODE = 'Not Specified'

             VPRINT 0,LN,NAME                           "L#20"
             VPRINT 21,LN,QO.ALPHA                        "L#7"
             VPRINT 31,LN,FIELD(ID,'~',1)                 "L#1"
             VPRINT 34,LN,DESC<1,1>                       "L#24"
             VPRINT 60,LN,ORN                           "L#12"


             GOSUB DISP.VN
             CT=1
             TEST = DESC.LN
             TEMP = DESC
             GOSUB PRT.LN
             CT=0
             TEST = COMM.LN
             TEMP = CLEAN.CMTS
             GOSUB PRT.LN

             *** Display Return code
             IF DSP.CODE AND LD(46)<1> # '' THEN
                CT=0
                TEST = 1
                TEMP = '** Ret Code: ':LD(46)<1>
                GOSUB PRT.LN
             END

          END CASE
          RETURN
*-------------------------------------------------------------------------*
PRT.LN:   *
          LOOP
             CT+=1
          WHILE TEMP<1,CT>#'' AND CT=<TEST DO
             LN+=1
             SORTBYS = INSERT(SORTBYS,LN;SORTBY)
             IDS     = INSERT(IDS,LN;ID)
             RQTYS   = INSERT(RQTYS,LN;QTY)
             PNS     = INSERT(PNS,LN;PN)
             VNS     = INSERT(VNS,LN;'')
             OIDS    = INSERT(OIDS,LN;OID)
             GENS    = INSERT(GENS,LN;GEN)
             SKIPLN  = INSERT(SKIPLN,LN;YES)
             BEGIN CASE
             CASE VIEW = 1 OR VIEW = 3
                COMMENT = INSERT(COMMENT,LN;CLEAN.CMTS)
                RCOM    = INSERT(RCOM,LN;LD(46)<1>)
             CASE OTHERWISE
                COMMENT = INSERT(COMMENT,LN;NEW.COMMENT)
                RCOM    = INSERT(RCOM,LN;LD(46)<1>)
             END CASE
             RPER    = INSERT(RPER,LN;LD(58)<1>)
             TREM    = INSERT(TREM,LN;LD(68)<1>)

             LN.CT  += 1
             VINS LN
             BEGIN CASE
             CASE VIEW = 1
                VPRINT 26,LN,TEMP<1,CT>                     "L#33"
             CASE VIEW = 2 OR VIEW = 4 OR VIEW = 5
                VPRINT 30,LN,TEMP<1,CT>                     "L#22"
             CASE OTHERWISE
                VPRINT 34,LN,TEMP<1,CT>                     "L#21"
             END CASE
          REPEAT
          RETURN
*-------------------------------------------------------------------------*
DISP.VN:  *
          BEGIN CASE
          CASE VIEW = 1
             VN = VNS<LN>
             IF VN='' THEN NAME='' ELSE
                READV NAME FROM CUSFILE,VN,1 ELSE NAME = ''
             END
             VPRINT 60,LN,NAME "L#18"
          CASE OTHERWISE
             VN = VNS<LN>
             IF VN = '' THEN NAME = '' ELSE
                READV NAME FROM CUSFILE,VN,1 ELSE NAME = ''
             END
             VPRINT 77,LN,NAME "L#1"
          END CASE
          RETURN
*-------------------------------------------------------------------------*
SUBS:     IF LN.CT = 0 THEN
             MESS 10,10,BELL:'Items must be Selected First'
             RETURN
          END
          ON OPTION GOTO VIEW.OID, EDIT.OID, RETURN.IT, ADJUST.IT, CREATE.PO, CREATE.PO, LOC.MNT, SETUP, HOLDIT, PRINTIT, PRD.INQ, WRRTY.INFO, FINDIT, RET.XFER,ORD.SORT,ORD.TYP,CHG.VIEW,CREATE.ALL
*-------------------------------------------------------------------------*
VIEW.OID: *
          IF SKIPLN<LINE> THEN RETURN
          ID   = IDS<LINE>
          OID  = FIELD(ID,'~',3)
          LDID = FIELD(ID,'~',4)
          GID  = FIELD(ID,'~',5)
          MODE = OID[1,1]
          INIT.VIEW = 1
          INIT.OID  = OID
          GOSUB GET.INIT.GEN
          VIEW.ONLY = YES
          VIEW.EDIT.LED INIT.OID,INIT.GEN,VIEW.ONLY,INIT.VIEW
          RETURN
*-------------------------------------------------------------------------*
EDIT.OID: *
          IF SKIPLN<LINE> THEN RETURN
          ID   = IDS<LINE>
          PN   = PNS<LINE>
          OID  = FIELD(ID,'~',3)
          LDID = FIELD(ID,'~',4)
          GID  = FIELD(ID,'~',5)
          MODE = OID[1,1]
          INIT.VIEW = 1
          INIT.OID  = OID
          GOSUB GET.INIT.GEN
          VIEW.ONLY = NO
          VIEW.EDIT.LED INIT.OID,INIT.GEN,VIEW.ONLY,INIT.VIEW
          FIX.LIST = PN
          SAVE.LN = LINE
          FOR LINE = 1 TO LN.CT
             IF FIELD(IDS<LINE>,'~',3) = OID THEN
                PN = PNS<LINE>
                LOCATE PN IN FIX.LIST BY 'AL' SETTING POS ELSE
                   FIX.LIST = INSERT(FIX.LIST,POS;PN)
                END
             END
          NEXT LINE
          GOSUB FIX.PNS
          IF LN.CT = 0 THEN RETURN TO START
          LINE = SAVE.LN
          RETURN
*-------------------------------------------------------------------------*
RETURN.IT:* ENTER RANGE OF LINES FOR VENDOR
          FIRST.LINE = LINE
          VEN = ''
          WINDOW ,,44,3,3
          PRINT @(0,1):"Enter Return to : ":
IN$$4:    INP VEN,18,1,25
          FINDID VN,VEN,'VENDOR','TENTITY;X;9;9',20,7,5,35,'SEL.ENT.POE','&INDEX&.SF',PO.BR
          WINDOW.CLOSE
          IF QUIT THEN RETURN
          READV NAME FROM CUSFILE,VN,1 ELSE NAME = '';VN=''
          BEGIN CASE
          CASE VIEW = 1 OR VIEW = 3
             VPRINT 60,FIRST.LINE,NAME "L#18"
             GOSUB SELINE
             IF QUIT THEN RETURN
             FOR LINE = FIRST.LINE TO LAST.LINE
                IF NOT(SKIPLN<LINE>) THEN
                   VNS<LINE> = VN
                   VPRINT 60,LINE,NAME "L#18"
                END
             NEXT LINE
             LINE = LAST.LINE
          CASE OTHERWISE
             VPRINT 62,FIRST.LINE,NAME "L#16"
             GOSUB SELINE
             IF QUIT THEN RETURN
             FOR LINE = FIRST.LINE TO LAST.LINE
                IF NOT(SKIPLN<LINE>) THEN
                   VNS<LINE> = VN
                   VPRINT 62,LINE,NAME "L#16"
                END
             NEXT LINE
             LINE = LAST.LINE
          END CASE
          RETURN
*-------------------------------------------------------------------------*
SELINE:   * GET FIRST & LAST LINES FOR HOT KEY UPDATES
          LAST.LINE  = ''
          WINDOW.CHILD 9,1,40,1,3
          PRINT @(10,1):BLINK$:"Move cursor to select last return good.":NORM$:
          ADJUST = YES
          GOSUB LOAD.HOTKEYS
          ADJUST = NO
          MOVE = 0; QUIT = 0; LASTKEY = 0
MOVESEL:  LASTLINE = LINE
          PARSEMOVE 1,LINE,1,LN.CT,15,DNOK
          IF SKIPLN<LINE> THEN
             DEF    = VSCROLL.DEF.<WINDOW.LEVEL,1>
             OFFSET = DEF<1,1,1>+DEF<1,1,6>
             IF LINE > OFFSET THEN
                VSCROLL LINE - OFFSET
             END
             IF LINE-LASTLINE>0 THEN MOVE=4 ELSE MOVE=2
             IF LINE=LN.CT THEN MOVE=2
             GOTO MOVESEL
          END
          *IF VIEW = 1 OR VIEW = 3 THEN
          IF VIEW = 1 THEN
             CUR.LOC = 60
          END ELSE
             CUR.LOC = 62
          END

IN$$5:    INPV A,CUR.LOC,LINE,0
          IF QUIT THEN GOTO SELEND
          IF MOVE # 5 THEN GOTO MOVESEL
          LAST.LINE = LINE

SELEND:   WINDOW.CHILD.CLOSE
          IF FIRST.LINE > LAST.LINE THEN
             OLD.FIRST  = FIRST.LINE
             FIRST.LINE = LAST.LINE
             LAST.LINE  = OLD.FIRST
          END
          RETURN
*-------------------------------------------------------------------------*
ADJUST.IT:* ADJUST CURRENT LINE
          IF NOT(ADJ.OK) THEN
            PRINT BELL:
            MSG='You do not have the proper authority to make adjustments.'
            MESS 11,1,MSG
            RETURN
          END

          FIRST.LINE = LINE
          ADJ.DATE =  DATE()
          ADJ.TYPE = 'RETURN'
          BEGIN CASE
          CASE VIEW = 1
             VPRINT 60,FIRST.LINE,'ADJUST' "L#18"
          CASE OTHERWISE
             VPRINT 62,FIRST.LINE,'ADJUST' "L#16"
          END CASE
          GOSUB SELINE
          IF QUIT THEN
             LN = FIRST.LINE
             GOSUB DISP.VN
             ADJUST = NO
             GOSUB LOAD.HOTKEYS
             RETURN
          END
          WINDOW ,,40,3,3
          PRINT @(0,1):BLINK$:'Creating Adjustment ...... ' "L#35":NORM$
          FIX.LIST = ''
          FOR LINE = FIRST.LINE TO LAST.LINE
             IF SKIPLN<LINE> THEN GOTO NEXT.LINE
             PN    =PNS<LINE>
             QTY   =RQTYS<LINE>
             ID    =IDS<LINE>
             TYPE  =FIELD(ID,'~',1)
             LOCA  =FIELD(ID,'~',2)
             IF FIELD(ID,'~',3) THEN
                TAG=FIELD(ID,'~',3):'.':FIELD(ID,'~',4)
                LOCA=LOCA:'^':TAG
             END
             AOE.AUTO.ADJ ADJ.DATE,ADJ.TYPE,PO.BR,PN,QTY,TYPE,LOCA,,,ERR.MSG
             IF ERR.MSG THEN
                MESS 10,10,BELL:ERR.MSG
                EXIT
             END
             LOCATE PN IN FIX.LIST BY 'AL' SETTING POS ELSE
                FIX.LIST = INSERT(FIX.LIST,POS;PN)
             END
NEXT.LINE:*
          NEXT LINE
          WINDOW.CLOSE

          IF FIX.LIST THEN
             GOSUB FIX.PNS
             IF LN.CT = 0 THEN
                ADJUST = NO
                RETURN TO START
             END
          END
          ADJUST = NO
          GOSUB LOAD.HOTKEYS
          RETURN
*-------------------------------------------------------------------------*
CREATE.PO:* Create a new PO (or Xfer) or let them add to an open one.

          IF SKIPLN<LINE> THEN RETURN
          SOURCE = VNS<LINE>
          IF SOURCE = '' THEN
             MESS 21,10,BELL:'Must enter Return to first'
             RETURN
          END
          FIX.LIST  = ''

*** Either create a transfer or a PO depending on if this is a br or vendor
          IF SOURCE[1,3] = 'BR#' THEN
             RXFER = YES
             RBR   = TRIM(FIELD(SOURCE,'#',2))
             READV BT.CN FROM TERRFILE,PO.BR,4 ELSE BT.CN = ''
             READV ST.CN FROM TERRFILE,RBR,  4 ELSE ST.CN = ''
             MODE  = 'T'
          END ELSE
             RXFER = NO
             ST.CN = SOURCE
             MODE  = 'P'
             READV BT.CN FROM CUSFILE,ST.CN,11 ELSE BT.CN = ''
             IF BT.CN  = '' THEN BT.CN = ST.CN
             *** Format RBR so correct branch is used in creating PO
             RBR = PO.BR
          END

*** If they chose the add option give them a list of orders to choose from
          ADD.TO    = NO
          SRC.OID   = ''
          SRC.GEN   = ''
          IF OPTION = 6 THEN
             ADD.TO = YES
             GOSUB GET.OID
             IF SRC.OID = '' THEN RETURN
             IF RXFER THEN SRC.GEN = 1
          END ELSE
             SHIP.DATE = DATE()
          END

*** Get a list of all the products that are being returned to this br/vend
          CT = 0
          FOR J = 1 TO LN.CT
             IF VNS<J> = SOURCE AND NOT(SKIPLN<J>) THEN
                CT += 1
                IF CT > 1 THEN EXIT
             END
          NEXT J

*** Ask if they would like to combine all of the products on one order.
          COMBINE.ALL = 'N'
          IF CT > 1 THEN
             IF RXFER THEN
                APRMT = 'Combine all items for Branch : '
             END ELSE
                APRMT = 'Combine all items for vendor : '
             END
IN.CMBN:     INP.PROMPT COMBINE.ALL,APRMT,'YN',1
             IF F12  THEN RETURN
             IF QUIT THEN GOTO IN.CMBN
          END

*** Update or create the new order.
          WINDOW ,,40,3,3
          IF RXFER THEN
             PRINT @(0,1):BLINK$:'Updating Xfer.....'  "L#35":NORM$
          END ELSE
             PRINT @(0,1):BLINK$:'Updating PO ......'  "L#35":NORM$
          END

*** Get the list of products, locations, tags, and qtys for the order.
          PNS.LIST = ''
          QTYS     = ''
          CGS      = ''
          SVCST    = ''
          TYPE.LIST= ''
          LOCAS    = ''
          RLOCAS   = ''
          IC       = 0
          COMMENTS = ''
          ADDLS    = ''
          IF COMBINE.ALL THEN
             SAVE.LINE = LINE
             FOR LINE = 1 TO LN.CT
                IF VNS<LINE>=SOURCE AND NOT(SKIPLN<LINE>) THEN GOSUB ADD.ITEM
             NEXT J
             LINE = SAVE.LINE
          END ELSE
             GOSUB ADD.ITEM
          END

*** If there aren't any products defined we can't create the order...
          IF PNS.LIST='' THEN GOTO ABORT.CREATE
          STATUS = 'O'
          PRICE.DATE = DATE()
          PN.LDIDS  = ''

          * Control record for copying over the original sales comment to
          * the PO.
          CRTL.ID = 'EXC.ORIG.SALE.CMNT'
          READ EXC.CMT FROM CTRLFILE,CRTL.ID ELSE EXC.CMT = ''

          * Excludes original sales comment if the control record is set to
          * do so.
          IF EXC.CMT THEN
             CMNT = COMMENTS
             CMT.CT = DCOUNT(CMNT,VM)
             FOR CC = CMT.CT TO 1 STEP -1
                 CMT2.CT = DCOUNT(CMNT<1,CC>,SVM)
                 FOR CC2 = CMT2.CT TO 1 STEP -1
                     CMT  = CMNT<1,CC,CC2>
                     IF CMT[1,16] = '** Original Sale' THEN
                        CMNT = DELETE(CMNT,1,CC,CC2)
                     END
                     IF CMT[1,10] = '** Cus PO:' THEN
                        CMNT = DELETE(CMNT,1,CC,CC2)
                     END
                 NEXT CC2
             NEXT CC
             COMMENTS = CMNT
          END
*** Add the items to the order.

          * If the control record says do not update cost for tagged
          * return SO from Return Goods Queue, clear the cost info.
          IF NOT(UPDATE.RETURN.COST) THEN
             SVCST = ''
             CGS = ''
          END

          OE.CREATE.LEDGER MODE,ADD.TO,SRC.OID,SRC.GEN,PO.BR,BT.CN,ST.CN,STATUS,SHIP.DATE,PRICE.DATE,PNS.LIST,QTYS,COMMENTS,TYPE.LIST,LOCAS,PN.LDIDS,,RBR,SHIP.DATE,TYPE.LIST,RLOCAS,CREATE.ERR,NETS,,ADDLS,,SVCST,CGS

          IF CREATE.ERR THEN
IN$$6:       INP.PROMPT '','Error Occurred during PO Creation'
             GOTO ABORT.CREATE
          END

*** Read in the ledger file and add the return goods source logic.
          MATREAD LED FROM LEDFILE,SRC.OID THEN
             IF MODE # 'T' THEN LED(30)<1,SRC.GEN> = 'RG'
             IF INDEX(LED(74)<1,SRC.GEN>, 'Return Goods', 1) = 0 THEN
                LED(74)<1,SRC.GEN,-1> = '** Return Goods **'
             END
             MATWRITE LED ON LEDFILE,SRC.OID
          END

*** Unlock the ledger record
          OE.UNLOCK.LED SRC.OID

*** HIDDEN CONTROL RECORD! Currently, only Connor Company needs this
          * functionality (created for HBJ853). They want users with level
          * 1 of OE.ALLOWED to be able to create and edit an order from
          * the Return Goods Queue. To do this, we will check the hidden
          * control record OE.RTN.GDS.AS.STK.RCPT and if it exists, we will
          * treat the PO created from the Return Goods Queue as a stock
          * receipt and allow editing.
          * If the OE.ALLOWED auth key is modified in future releases, we
          * may be able to remove this functionality.
          READV STK.RCPT FROM CTRLFILE,'OE.RTN.GDS.AS.STK.RCPT',1 ELSE
             STK.RCPT = ''
          END

*** Display the new order for them to view it...
          IF STK.RCPT THEN
             INIT.VIEW = 'STOCK.RECEIPTS'
          END ELSE
             INIT.VIEW = 1
          END
          INIT.OID  = SRC.OID
          INIT.GEN  = SRC.GEN
          VIEW.ONLY = NO
          OE MODE, INIT.VIEW, INIT.OID, INIT.GEN, VIEW.ONLY
          QUIT = NO

ABORT.CREATE: *
          WINDOW.CLOSE
          ADJUST = NO
          GOSUB LOAD.HOTKEYS; * Re-enable Ad<J>ust hotkey
          IF FIX.LIST THEN
             GOSUB FIX.PNS
             IF LN.CT = 0 THEN RETURN TO START
          END

          RETURN
*-------------------------------------------------------------------------*
CREATE.ALL:  *** Create all PO's (or Xfers) based on which IDs have a
             *** VN assigned.

          CR.SV.LINE = LINE
          FIX.LIST   = ''

          VN.CT = 0
          ID.CT = DCOUNT(IDS,AM)
          FOR IDX = 1 TO ID.CT
             IF VNS<IDX> AND NOT(SKIPLN<IDX>) THEN
                VN.CT += 1
             END
          NEXT IDX

          IF VN.CT < 1 THEN
             MESS 21,10,BELL:'Must enter Return to first'
             RETURN
          END

          *** Ask the user if they want to combine items, or have seperate
          *** OIDs for each item.
          COMBINE.ALL = 'Y'
          IF VN.CT > 1 THEN
             APRMT = 'Combine all items assigned to a common Vendor/Branch : '
IN.CMBN2:    INP.PROMPT COMBINE.ALL,APRMT,'YN',1
             IF F12  THEN RETURN
             IF QUIT THEN GOTO IN.CMBN2
          END ELSE
             COMBINE.ALL = NO
          END

          USED.IDS    = ''
          NEW.OIDS    = ''
          NEW.OIDS.CT = 0
          ID.CT = DCOUNT(IDS,AM)
          FOR LINE = 1 TO ID.CT
             IF SKIPLN<LINE>                           THEN CONTINUE
             IF NOT(VNS<LINE>)                         THEN CONTINUE
             ID = IDS<LINE>
             LOCATE ID IN USED.IDS SETTING NADA        THEN CONTINUE

             *** Either create a transfer or a PO depending on if this is
             *** a br or vendor.
             SOURCE = VNS<LINE>
             IF SOURCE[1,3] = 'BR#' THEN
                RXFER = YES
                RBR   = TRIM(FIELD(SOURCE,'#',2))
                READV BT.CN FROM TERRFILE,PO.BR,4 ELSE BT.CN = ''
                READV ST.CN FROM TERRFILE,RBR,  4 ELSE ST.CN = ''
                MODE  = 'T'
             END ELSE
                RXFER = NO
                ST.CN = SOURCE
                MODE  = 'P'
                READV BT.CN FROM CUSFILE,ST.CN,11 ELSE BT.CN = ''
                IF BT.CN  = '' THEN BT.CN = ST.CN
                *** Format RBR so correct branch is used in creating PO
                RBR = PO.BR
             END

             ADD.TO    = NO
             SRC.OID   = ''
             SRC.GEN   = ''
             SHIP.DATE = DATE()

             *** Get the list of products, locations, tags, and qtys for
             *** the order.
             PNS.LIST = ''
             QTYS     = ''
             TYPE.LIST= ''
             LOCAS    = ''
             RLOCAS   = ''
             IC       = 0
             COMMENTS = ''
             ADDLS    = ''
             ROQIDS   = ''

             IF COMBINE.ALL THEN
                SAVE.LINE = LINE
                FOR LINE = 1 TO LN.CT
                   TST.ID = IDS<LINE>
                   LOCATE TST.ID IN USED.IDS SETTING NADA THEN CONTINUE
                   IF VNS<LINE>=SOURCE AND NOT(SKIPLN<LINE>) THEN
                      GOSUB ADD.ITEM
                      USED.IDS<-1> = TST.ID
                      ID         = IDS<LINE>
                      OID        = FIELD(ID,'~',3)
                      LDID       = FIELD(ID,'~',4)
                      PN         = PNS<LINE>
                      ROQIDS<-1> = OID:'.':PN:'.':LDID
                   END
                NEXT J
                LINE = SAVE.LINE
             END ELSE
                GOSUB ADD.ITEM
                USED.IDS<-1> = ID
                OID          = FIELD(ID,'~',3)
                LDID         = FIELD(ID,'~',4)
                PN           = PNS<LINE>
                ROQIDS<-1>   = OID:'.':PN:'.':LDID
             END

             *** If no products defined, can't create the order...
             IF PNS.LIST='' THEN CONTINUE
             STATUS = 'O'
             PRICE.DATE = DATE()
             PN.LDIDS  = ''

             *** Add the items to the order.
             OE.CREATE.LEDGER MODE,ADD.TO,SRC.OID,SRC.GEN,PO.BR,BT.CN,ST.CN,STATUS,SHIP.DATE,PRICE.DATE,PNS.LIST,QTYS,COMMENTS,TYPE.LIST,LOCAS,PN.LDIDS,,RBR,SHIP.DATE,TYPE.LIST,RLOCAS,CREATE.ERR,,,ADDLS

             *** Let the user know about an error for the Vendor/Branch.
             IF CREATE.ERR THEN
                EPRMT = 'Error During Creation for '
                IF SOURCE[1,3] = 'BR#' THEN
                   EBR   = TRIM(FIELD(SOURCE,'#',2))
                   EPRMT:= 'Branch ':EBR
                END ELSE
                   ST.CN = SOURCE
                   READV ENAME FROM CUSFILE,ST.CN,1 ELSE ENAME = ST.CN
                   EPRMT:= 'Vendor ':ENAME<1,1>[1,15]
                END
IN.ERR:         INP.PROMPTNO '',EPRMT
                CONTINUE
             END

             *** Make sure to clean out the vendor associations.
             ROQ.CT = DCOUNT(ROQIDS,AM)
             FOR ROQX = 1 TO ROQ.CT
                ROQID = ROQIDS<ROQX>
                DELETE ROQFILE,ROQID
             NEXT ROQX

             *** Read in the led file and add the ret goods source logic.
             MATREAD LED FROM LEDFILE,SRC.OID THEN
                IF MODE # 'T' THEN LED(30)<1,SRC.GEN> = 'RG'
                IF INDEX(LED(74)<1,SRC.GEN>, 'Return Goods', 1) = 0 THEN
                   LED(74)<1,SRC.GEN,-1> = '** Return Goods **'
                END
                MATWRITE LED ON LEDFILE,SRC.OID
             END

             *** Unlock the ledger record
             OE.UNLOCK.LED SRC.OID

             *** Create the list of new oids created so the user can
             *** choose to view that order.
             IF SOURCE[1,3] = 'BR#' THEN
                VNM    = 'Branch ':TRIM(FIELD(SOURCE,'#',2))
             END ELSE
                ST.CN  = SOURCE
                READV ENAME FROM CUSFILE,ST.CN,1 ELSE ENAME = ST.CN
                VNM    = ENAME<1,1>[1,20]
             END
             DISP.DESC = SRC.OID:' - ':VNM
             NEW.OIDS.CT += 1
             NEW.OIDS<1,NEW.OIDS.CT> = DISP.DESC
             NEW.OIDS<2,NEW.OIDS.CT> = SRC.OID
             NEW.OIDS<3,NEW.OIDS.CT> = SRC.GEN

          NEXT LINE


          GOSUB PRESENT.OIDS

          IF FIX.LIST THEN
             GOSUB FIX.PNS
             IF LN.CT = 0 THEN RETURN TO START
          END
          RETURN TO START
*-------------------------------------------------------------------------*
PRESENT.OIDS: *** Show the user which oids were created, and give them the
              *** opportunity to edit that order.
          BEGIN CASE
          CASE NEW.OIDS.CT < 1
             OMSG = 'No Orders Created'
             ERR.MESS 5,2,OMSG
             RETURN
          CASE NEW.OIDS.CT = 1
             INIT.OID = NEW.OIDS<2,1>
             INIT.GEN = NEW.OIDS<3,1>

             OE INIT.OID[1,1],1,INIT.OID,INIT.GEN,NO
             RETURN
          END CASE

          SELITEM = 1
          MROWS = 8
          IF NEW.OIDS.CT < 8 THEN MROWS = NEW.OIDS.CT
          MTITLE = 'Choose An Order To View'

SHOW.OID: *
          MENU.TABLE WORD,25,2,1,MROWS,30,,,NEW.OIDS<1>,MTITLE,SELITEM
          IF NOT(QUIT) THEN
             LOCATE WORD IN NEW.OIDS<1> SETTING NMPOS ELSE NMPOS = SELITEM

             INIT.OID = NEW.OIDS<2,NMPOS>
             INIT.GEN = NEW.OIDS<3,NMPOS>

             OE INIT.OID[1,1],1,INIT.OID,INIT.GEN,NO
             QUIT     = NO
             GOTO SHOW.OID
          END
          RETURN
*-------------------------------------------------------------------------*
ADD.ITEM: *

          ID   = IDS<LINE>
          PN   = PNS<LINE>
          QTY  = RQTYS<LINE>

          * check if there is cost override
          * ID example is ID=R~~S1694680~1~109061
          CG.OID = FIELD(ID,'~',3)
          CG.LDID= FIELD(ID,'~',4)
          LD.READV CG,CG.OID,CG.LDID,10

          IF QTY#0 AND NUM(PN) AND PN#'' THEN
             ** Do not allow negative transfers.
             IF MODE = 'T' THEN QTY = ABS(QTY)

             IC += 1
             PNS.LIST<1,IC> = PN
             QTYS<1,IC>     = QTY
             CGS<1,IC> = CG
             * set the override flag
             IF CG THEN SVCST<1,IC> = 1

             TYPE.LIST<1,IC>= FIELD(ID,'~',1)
             LOCA           = FIELD(ID,'~',2)
             RLOCA          = ''
             IF FIELD(ID,'~',3) THEN
                TAG   = FIELD(ID,'~',3):'.':FIELD(ID,'~',4)
                LOCA  = LOCA:'^':TAG
                RLOCA = '^':TAG
             END
             LOCAS<1,IC>  = LOCA
             RLOCAS<1,IC> = RLOCA
             LOCATE PN IN FIX.LIST BY 'AL' SETTING POS ELSE
                FIX.LIST = INSERT(FIX.LIST,POS;PN)
             END
             IF HAJOCA.SITE$ THEN
                RET.OID    = OIDS<LINE>
                RET.MODE   = RET.OID[1,1]
                RET.GEN    = GENS<LINE>
                RET.LDID   = FIELD(ID,'~',4)
                LD.READV ORIG.PN,RET.OID,RET.LDID,1
                IF (ORIG.PN = PN) THEN
                   IF (RET.MODE = "P" OR RET.MODE = "T") THEN
                      LD.ATTB = 8
                   END ELSE
                      LD.ATTB = 10
                   END
                   IF RET.MODE # "A" THEN
                      LD.READV RET.COGS,RET.OID,RET.LDID,LD.ATTB
                      NETS<1,IC> = RET.COGS<1,RET.GEN>
                   END ELSE
                      NETS<1,IC> = ""
                   END
                END ELSE
                   GOSUB CALC.KIT
                END
             END
          END
          COMMENTS<1,IC> = LOWER(COMMENT<LINE>)
          ADDLS<1,IC,2> = LOWER(RCOM<LINE>)
          ADDLS<1,IC,3> = LOWER(RPER<LINE>)
          ADDLS<1,IC,4> = LOWER(TREM<LINE>)

          RETURN
*-------------------------------------------------------------------------*
CALC.KIT: *
          IF RET.MODE = "A" THEN
             NETS<1,IC> = ""
             RETURN
          END

          GET.ALL.PRD BR,ORIG.PN,1
          LOCATE PN IN PRD(53)<1> SETTING KIT.POS THEN
             GOSUB CALC.TOT
             KIT.QTY = PRD(52)<1,KIT.POS>
             IF KIT.QTY = 0 THEN KIT.QTY = 1
             GET.ALL.PRD BR,PN,1
             GOSUB CALC.CUR
             IF RET.MODE = "P" THEN LD.ATTB = 8 ELSE LD.ATTB = 10
             LD.READV RET.COGS,RET.OID,RET.LDID,LD.ATTB
             KIT.COGS   = INT((RET.COGS<1,RET.GEN> * COMP.PERC) / KIT.QTY)
             NETS<1,IC> = KIT.COGS
          END ELSE
             NETS<1,IC> = ""
          END

          RETURN
*-------------------------------------------------------------------------*
CALC.CUR: ***
          GLOBAL.BASN.GET 4,COST.BASN
          PRC.DATE = DATE()
          GET.BASE PN,BR,COST.BASN,PRC.DATE,IQCOGS,,PRD(86),PRD(52),PRD(53),PRD(87)
          COMP.TOTAL = IQCOGS * KQTYS<1,KIT.POS>
          COMP.PERC  = COMP.TOTAL / KIT.TOTAL

          RETURN
*-------------------------------------------------------------------------*
CALC.TOT: ***
          GLOBAL.BASN.GET 4,COST.BASN
          PRC.DATE = DATE()
          IF HAJOCA.SITE$ THEN
             KOPTS      = 2
             KOPTS<1,3> = 2
             KOPTS<1,4> = 2
          END
          KQTYS    = PRD(52)
          KPNS     = PRD(53)
          KSPOIL   = PRD(87)
          GET.BASE ORIG.PN,BR,COST.BASN,PRC.DATE,IQCOGS,,KOPTS,KQTYS,KPNS,KSPOIL
          KIT.TOTAL = IQCOGS
          RETURN
*-------------------------------------------------------------------------*
DEL.LN:   *
          PRINTER RESET  ;* Paranoid disable of pagebreaks.

          VDEL LN
          *** Get the info for the ID to the ROQfile, and make sure to
          *** delete the vendor assignment for this id.
          ID = IDS<LN>
          OID  = FIELD(ID,'~',3)
          LDID = FIELD(ID,'~',4)
          ROQID = OID:'.':PN:'.':LDID
          DELETE ROQFILE,ROQID

          IDS     = DELETE(IDS,LN)
          SORTBYS = DELETE(SORTBYS,LN)
          RQTYS   = DELETE(RQTYS,LN)
          VNS     = DELETE(VNS,LN)
          PNS     = DELETE(PNS,LN)
          COMMENT = DELETE(COMMENT,LN)
          OIDS    = DELETE(OIDS,LN)
          GENS    = DELETE(GENS,LN)
          SKIPLN  = DELETE(SKIPLN,LN)
          LN.CT  -= 1
          IF LINE > LN THEN LINE -= 1
          IF LINE > LN.CT THEN LINE = LN.CT
          RETURN
*-------------------------------------------------------------------------*
GET.OID:  *** Get the Order thay want to add these products to.
          ADD.OIDS = ''; NEW.PO.IDS = ''

*** List of open POs for this vendor
          IF NOT(RXFER) THEN
             READV PO.IDS FROM ENTDFILE,BT.CN,1 ELSE PO.IDS = ''
             CT = DCOUNT(PO.IDS,VM)
             FOR J = 1 TO CT
                IF PO.IDS<1,J>[1,1]#'P' THEN CONTINUE
                GID     = FIELD(PO.IDS<1,J>,'.',2)+0
                SRC.OID = FIELD(PO.IDS<1,J>,'.',1)

*** Read in the PO Ledger record and make sure it's for the correct ship
*** to branch and ship from vendor before letting them choose to add to it
                MATREAD TEMP.LED FROM LEDFILE,SRC.OID ELSE MAT TEMP.LED=''
                LOCATE GID IN TEMP.LED(12)<1> SETTING SRC.GEN THEN
                   IF TEMP.LED(2)<1,SRC.GEN,2> = PO.BR THEN
                      IF TEMP.LED(5)<1,SRC.GEN> = ST.CN THEN
                         NEW.PO.IDS<1,-1> = PO.IDS<1,J>
                      END
                   END
                END
             NEXT J

             PO.IDS = NEW.PO.IDS
             MENU.TABLE ORN,1,3,1,8,78,'CALL LED.SELECT.CONV',1,PO.IDS,'P/O #Ord DateOrder IDShip From'

             SRC.OID = FIELD(ORN,'.',1)
             GID     = FIELD(ORN,'.',2)+0

             READV LED12 FROM LEDFILE,SRC.OID,12 ELSE LED12 = ''
             LOCATE GID IN LED12<1> SETTING SRC.GEN ELSE SRC.OID = ''
             SHIP.DATE = DATE()
          END ELSE
*** List of open transfers
             EXE = 'SSELECT ORDER.QUEUE = "T]" AND WITH @ID = "[1"'
             EXECUTE EXE CAPTURING MSG

*** Loop through all of the transfers and make sure they're still open.
             LOOP
             READNEXT ID ELSE EXIT
             TOID = FIELD(ID,'.',1)
             GID  = FIELD(ID,'.',3)+0
             MATREAD LED FROM LEDFILE,TOID        ELSE GOTO NID
             LOCATE GID IN LED(12)<1> SETTING GEN ELSE GEN = 1
             IF LED(2)<1,GEN,1> # PO.BR           THEN GOTO NID
             IF LED(2)<1,GEN+1,1> # RBR           THEN GOTO NID
             ADD.OIDS<1,-1> = TOID
NID:         REPEAT

             OW.LEN = DCOUNT(ADD.OIDS<1>,VM)
             IF OW.LEN > 10 THEN OW.LEN = 10

*** List of all open transfers going from this branch to the recv branch...
             MENU.TABLE WORD,,,1,OW.LEN,12,'MCU',,ADD.OIDS,'Open XFers'
             IF QUIT THEN RETURN
             SRC.OID = WORD
             SRC.GEN = 1
             READV SHIP.DATE FROM LEDFILE,SRC.OID,9 ELSE SHIP.DATE = DATE()
             SHIP.DATE = SHIP.DATE<1,1>
             IF SHIP.DATE = '' THEN SHIP.DATE = DATE()
          END

          RETURN
*-------------------------------------------------------------------------*
GET.PRINT.DATA:*** get print data
          PRT.PNS = ''
          PRT.RQTYS = ''
          PRT.IDS = ''
          PRT.VNS = ''
          FOR I = 1 TO LN.CT
             IF NOT(SKIPLN<I>) THEN
                PRT.PNS<-1> = PNS<I>
                PRT.IDS<-1> = IDS<I>
                PRT.VNS<-1> = VNS<I>
                PRT.RQTYS<-1> = RQTYS<I>
             END
          NEXT I
          RETURN
*-------------------------------------------------------------------------*
PRINTIT:  LOC = LOCATION
          GOSUB GET.PRINT.DATA
          PUR.RETQ.PRINT LOC,PO.BR,PRT.PNS,PRT.RQTYS,PRT.IDS,PRT.VNS
          RETURN
*-------------------------------------------------------------------------*
HOLDIT:   LOC = 'HOLD'
          GOSUB GET.PRINT.DATA
          PUR.RETQ.PRINT LOC,PO.BR,PRT.PNS,PRT.RQTYS,PRT.IDS,PRT.VNS
          RETURN
*-------------------------------------------------------------------------*
PRD.INQ:  PN  = PNS<LINE>
          PRD.VIEW PN,PO.BR

          RETURN
*-------------------------------------------------------------------------*
WRRTY.INFO: * Display the warranty info from the original oid.
          PN      = PNS<LINE>
          ID      = IDS<LINE>
          OID     = FIELD(ID,'~',3)
          LDID    = FIELD(ID,'~',4)
          GID     = FIELD(ID,'~',5)
          MODE    = OID[1,1]
          SV.LDID = LDID

          IF MODE # 'S' THEN RETURN

          GOSUB GET.INIT.GEN
          MAT OLED = MAT LED; MAT OLD.LD = MAT LD

          GET.ALL.PRD LED(2)<1,INIT.GEN,1>,PN,1

*** Lock the record... If not message them and go on.
          OE.LOCK.LED OID,LOCK.MSG,YES
          IF LOCK.MSG THEN
             MESS 1,2,'Order is Locked by Another User'
             MESS 1,3,'Please Try Again later...      '
             GOTO END.WRRTY
          END

          *** Only check GL date if order is closed
          OK = YES
          IF LED(8)<1,INIT.GEN> THEN
             CHK.GL.POST LED(23)<1,INIT.GEN>,OK,MODE
          END

          IF NOT(OK) THEN
            WINDOW ,,40,4,3
            PRINT @(1,1):"Item is in a Closed Accounting Period!"
            PRINT @(1,2):"You will only be allowed to View the "
            PRINT @(1,3):"Return Info..."
IN$$13:     INP A,,,0
            WINDOW.CLOSE
            RET.VIEW.ONLY = YES
          END ELSE
            RET.VIEW.ONLY = NO
          END
*** Edit the info and update the ledger info when done.
          SOE.RETURN.CHECK OID:VM:1,INIT.GEN,LDID,'','',RET.VIEW.ONLY

          LDID = SV.LDID
          LD.PUT LDID
          UPDATE.LEDGER.DET OID,LDID,1,'',''
          UPDATE.LEDGER OID,''
          OE.UNLOCK.LED OID

*** Make sure our list of pns is correct and display it.
          FIX.LIST = PN
          SAVE.LN  = LINE
          FOR LINE = 1 TO LN.CT
             IF FIELD(IDS<LINE>,'~',3) = OID THEN
                PN = PNS<LINE>
                LOCATE PN IN FIX.LIST BY 'AL' SETTING POS ELSE
                   FIX.LIST = INSERT(FIX.LIST,POS;PN)
                END
             END
          NEXT LINE
          GOSUB FIX.PNS
          IF LN.CT = 0 THEN RETURN TO START
          LINE = SAVE.LN

END.WRRTY:* End of warranty update
          RETURN
*-------------------------------------------------------------------------*
FINDIT:   *** Find a specific part number and go to that line...
          FPN     = ''
          SV.LINE = LINE
IN$$9:    INP.PROMPT FPN,'Enter Product ID : ',,35,'S:VERF.PRD.ID'
          IF FPN = '' THEN RETURN
          LOCATE FPN IN PNS SETTING LINE ELSE LINE = SV.LINE
          MOVE = ''; LASTKEY = ''; QUIT = ''
          RETURN TO MOVENEXT
*-------------------------------------------------------------------------*
RET.XFER: *** Create a transfer to move these items to a dif. branch...
          FIRST.LINE = LINE
          OLD.RBR    = RBR
IN$$10:   INP.PROMPT RBR,'Enter Return Branch : ',,4

          IF F12 THEN
             RBR = OLD.RBR
             RETURN
          END

          VERIFY.BR RBR,NAME,BRS
          IF RBR = ''    THEN PRINT BELL:; GOTO IN$$10
          IF RBR = PO.BR THEN PRINT BELL:; GOTO IN$$10
          IF QUIT THEN RETURN

          BEGIN CASE
          CASE VIEW = 1 OR VIEW = 3
             VPRINT 60,FIRST.LINE,'Br# ':RBR "L#14"
          CASE OTHERWISE
             VPRINT 62,FIRST.LINE,'Br# ':RBR "L#12"
          END CASE
          GOSUB SELINE
          IF QUIT THEN RETURN
          FOR LINE = FIRST.LINE TO LAST.LINE
             IF NOT(SKIPLN<LINE>) THEN
                VNS<LINE> = 'BR#':RBR
                BEGIN CASE
                CASE VIEW = 1 OR VIEW = 3
                   VPRINT 60,LINE,'Br# ':RBR "L#14"
                CASE OTHERWISE
                   VPRINT 62,LINE,'Br# ':RBR "L#12"
                END CASE
             END
          NEXT LINE
          LINE = LAST.LINE
          RETURN

          RETURN
*-------------------------------------------------------------------------*
ORD.SORT: *
          SORT.TBL = 'Buy Line':VM:'Return Code':VM:'Sales Order Number':VM:'Ship Date'
          MENU.TABLE VAR,30,10,1,4,20,,,SORT.TBL,'Sort Choices',CSORT
          LOCATE VAR IN SORT.TBL<1> SETTING CSORT ELSE CSORT = 1
          RETURN TO RESTART
*-------------------------------------------------------------------------*
ORD.TYP:  *
          TYP.TBL = 'Both':VM:'Open':VM:'Closed'
          MENU.TABLE VAR,30,10,1,3,20,,,TYP.TBL,'Order Choices',BOC
          IF QUIT THEN QUIT = ''; F12 = ''; RETURN
          LOCATE VAR IN TYP.TBL<1> SETTING BOC ELSE BOC = 1
          VCLR 1
          RETURN TO RESTART
*-------------------------------------------------------------------------*
CHG.VIEW: *
          VIEW.OPTS = 'Return Goods Queue':VM:'Add Ship Date With Gen':VM:'Display Cust Name':VM:'Economic Flag'

          IF JOHNSTONE.SITE$ AND JS.OPT THEN
             VIEW.OPTS := VM:'Warranty Tag'
          END

          SV.VIEW = VIEW
          LN = LINE

          * Define number of rows to display
          IF JOHNSTONE.SITE$ AND JS.OPT THEN
             DNO = 5
          END ELSE
             DNO = 4
          END

          MENU.TABLE ,,,1,DNO,24,,,VIEW.OPTS,'View Choices',VIEW
          VIEW = OPTION
          IF QUIT THEN VIEW = SV.VIEW
          IF VIEW = SV.VIEW THEN RETURN
          IF SV.VIEW # 1 THEN
             WINDOW.CHILD.CLOSE
          END
          BEGIN CASE
          CASE VIEW = 1
             FOR LINE = 3 TO 17
                PRINT @(15,LINE):' '
                PRINT @(28,LINE):' '
                PRINT @(30,LINE):' '
                PRINT @(53,LINE):' '
                PRINT @(62,LINE):' '
             NEXT LINE
          CASE VIEW = 2
             WINDOW.CHILD 1,2,78,17,9
             PRINT 'Order#ReturnQtyTDescriptionShipDateReturnTo'
             PRINT @(1,18):''

             FOR LINE = 3 TO 17
                PRINT @(15,LINE):''
                PRINT @(28,LINE):''
                PRINT @(30,LINE):''
                PRINT @(53,LINE):''
                PRINT @(62,LINE):''
             NEXT LINE
          CASE VIEW = 4
             WINDOW.CHILD 1,2,78,17,9
             PRINT 'Order#ReturnQtyTDescriptionEconomicReturnTo'
             PRINT @(1,18):''

             FOR LINE = 3 TO 17
                PRINT @(15,LINE):''
                PRINT @(28,LINE):''
                PRINT @(30,LINE):''
                PRINT @(53,LINE):''
                PRINT @(62,LINE):''
             NEXT LINE
          CASE VIEW = 5
             WINDOW.CHILD 1,2,78,17,9
             PRINT 'Order#ReturnQtyTDescriptionEconomicWarranty Tag'
             PRINT @(1,18):''

             FOR LINE = 3 TO 17
                PRINT @(15,LINE):''
                PRINT @(28,LINE):''
                PRINT @(30,LINE):''
                PRINT @(53,LINE):''
                PRINT @(62,LINE):''
             NEXT LINE
          CASE OTHERWISE
             WINDOW.CHILD 1,2,78,17,9
             PRINT 'CustNameRetQtyTDescriptionOrder#'
             PRINT @(1,18):''

             FOR LINE = 3 TO 17
                PRINT @(21,LINE):''
                PRINT @(31,LINE):''
                PRINT @(33,LINE):''
                PRINT @(50,LINE):' '
                PRINT @(60,LINE):''
             NEXT LINE
          END CASE

          RETURN TO RESTART
*-------------------------------------------------------------------------*
SETUP:    *
          PUR.RETURN.GOODS.SETUP DESC.LN,COMM.LN,DSP.CODE
          QUIT=NO
          LASTMOVE=''
          IF F12 THEN
             F12=NO
             RETURN
          END ELSE
             VCLR 1
             RETURN TO RESTART
          END
*-------------------------------------------------------------------------*
LOC.MNT:  PN       = PNS<LINE>
          FIX.LIST = PN
          PRD.LOCATION.MAINT PN:AM:PO.BR
          GOSUB FIX.PNS
          IF LN.CT = 0 THEN RETURN TO START
          RETURN
*-------------------------------------------------------------------------*
PRINT.IT: ***Print Returned Goods Report
          TITLE     = 'Returned Goods : ':OCONV(DATE(),'D2/')
          HDR       = 'Returned Goods for Branch: ':PO.BR:'       '
          HDR      := OCONV(DATE(),'D2/'):'             Page : ^#####'

          HDR<1,3>  = 'Buy Line Invoice#     Inv Date '
          HDR<1,4>  = '-------- ------------ -------- '
          HDR<1,3> := 'Customer                       '
          HDR<1,4> := '------------------------------ '
          HDR<1,3> := 'Return Qty    T  '
          HDR<1,4> := '------------  -  '
          HDR<1,3> := 'Description                  '
          HDR<1,4> := '---------------------------- '
          HDR<1,3> := 'Return to'
          HDR<1,4> := '-------------------------'

          PRINTER.ON 130,TITLE,DOC.ID,HDR
          FOR LN = 1 TO LN.CT
             IF SKIPLN<LN> THEN GOTO SKIP.LINE
             PN   = PNS<LN>
             ID   = IDS<LN>
             OID  = FIELD(ID,'~',3)
             LDID = FIELD(ID,'~',4)
             GID  = FIELD(ID,'~',5)
             GOSUB GET.INIT.GEN
             INVN    = LED(8)<1,INIT.GEN>
             IF OID # '' THEN
                ORD.ID = OID:'.':INVN"R%3"
             END ELSE
                ORD.ID = ''
             END
             BT      = LED(1)<1,INIT.GEN>
             READV BT.NAME  FROM CUSFILE,BT,1  ELSE BT.NAME = ''
             VN   = VNS<LN>
             READV NAME  FROM CUSFILE,VN,1  ELSE NAME = ''
             MATREAD PRD FROM PRDFILE,PN ELSE MAT PRD = ''
             DESC  = PRD(1)
             BLINE = PRD(12)

             ** Look at the product first for the UM.  If not there,
             ** go to the priceline JAMESV 10/13/98
             IF PRD(15) = '' THEN
                READV UM.TBL FROM PLNEFILE,PRD(9),3 ELSE UM.TBL = ''
             END ELSE
                UM.TBL = PRD(15)
             END

             IQ.TO.ALPHA UM.TBL,PRD(7),LD(23),RQTYS<LN>,Q1,U1,Q2,U2,QO.ALPHA
             CONVERT VM TO ' ' IN DESC
             PRINT BLINE                            "L#8 ":
             PRINT ORD.ID                           "L#12 ":
             PRINT OCONV(LED(9)<1,INIT.GEN>,"D2/")  "L#8 ":
             PRINT BT.NAME                          "L#30 ":
             PRINT QO.ALPHA                         "R#12 ":
             PRINT FIELD(IDS<LN>,'~',1)             "R#2  ":
             PRINT DESC                             "L#28 ":
             PRINT NAME                             "L#25 ":"PN#":PN
             PRINT
SKIP.LINE:*
          NEXT LN
          PRINTER.OFF DOC.ID,LOC
          RETURN
*-------------------------------------------------------------------------*
FIX.DISP: * GET LIST OF OLD.LOCS & NEW.LOCS AND FIX DISPLAY
          GOSUB GET.NEW
          SV.IDS = IDS
          SV.VEN = VNS
          LOC.CT = DCOUNT(OLD.LOCS,AM)
          FOR J = 1 TO LOC.CT
             ID = OLD.LOCS<J>
             LOCATE ID IN NEW.LOCS SETTING POS ELSE POS=0
             LOCATE ID IN IDS SETTING LN ELSE LN = 0
             IF POS THEN
                NEW.LOCS  = DELETE(NEW.LOCS,POS)
                RQTYS<LN> = NEW.QTYS<POS>
                NEW.QTYS  = DELETE(NEW.QTYS,POS)
                GOSUB DISP.LN
                IF OSTAT = 'X' THEN CONTINUE
                LINE = LN
             END ELSE
                IF LN THEN GOSUB DEL.LN
             END
          NEXT J
          LOC.CT = DCOUNT(NEW.LOCS,AM)
          FOR J = 1 TO LOC.CT
             ID  = NEW.LOCS<J>
             QTY = NEW.QTYS<J>
             GOSUB DISP.LN
             LINE = LN
          NEXT J
          SV.IDS = ''
          SV.VEN = ''
          RETURN
*-------------------------------------------------------------------------*
FIX.PNS:  * FIX PRODUCTS AFTER ADJUSTMENT OR PO
          PN.CT = DCOUNT(FIX.LIST,AM)
          FOR PN.INDX = 1 TO PN.CT
             PN = FIX.LIST<PN.INDX>
             GOSUB GET.OLD
             GOSUB FIX.DISP
          NEXT PN.INDX

          RETURN
*-------------------------------------------------------------------------*
GET.INIT.GEN: *
          MATREAD LED FROM LEDFILE,OID ELSE MAT LED = ''
          LD.GET LDID
          CHK.LOC = FIELD(ID,'~',1,2)
          L.CT = DCOUNT(LD(7),VM)
          FOR INIT.GEN = 1 TO L.CT
          LOCATE CHK.LOC IN LD(7)<1,INIT.GEN> SETTING POS THEN EXIT
          NEXT GEN
          IF INIT.GEN > L.CT THEN
             FINDSTR CHK.LOC IN LD(7) SETTING XX,INIT.GEN ELSE
                LOCATE GID IN LED(12)<1> SETTING INIT.GEN ELSE INIT.GEN = 1
             END
          END

          RETURN
*-------------------------------------------------------------------------*
CLEAN.CMTS:  *
          *** Clean out prior product cmts.  No need since using prd desc.
          COMS = LD(3)
          CONVERT SVM TO VM IN COMS
          CMT.CT = DCOUNT(COMS,VM)
          FOR CC = CMT.CT TO 1 STEP -1
          CMT = COMS<1,CC>
          BEGIN CASE
          CASE CMT[1,6]='Your L'
             COMS = DELETE(COMS,1,CC)
          CASE CMT[1,6]='Your #'
             COMS = DELETE(COMS,1,CC)
          CASE CMT[1,18]='** Return Percent:'
             COMS = DELETE(COMS,1,CC)
          CASE CMT[1,18]='** Original Depth:'
             COMS = DELETE(COMS,1,CC)
          CASE CMT[1,18]='** Remaining Depth'
             COMS = DELETE(COMS,1,CC)
          END CASE
          NEXT CC
          *** Append return comments to desc if system is set up to do so
          IF RET.CMTS AND LD(45) THEN COMS<1,-1> = LD(45)
          CLEAN.CMTS = COMS
          RETURN
*-------------------------------------------------------------------------*
LOAD.HOTKEYS: **
          MENU.CLEAR
          MENU.LOAD  2,19, 4,1,'V'
          MENU.LOAD  9,19, 4,1,'E'
          MENU.LOAD 16,19, 9,1,'R'
          IF ADJUST THEN
             MENU.LOAD ,,,,
          END ELSE
             MENU.LOAD 31,19, 5,3,'J'
          END
          MENU.LOAD 39,19, 6,1,'C'
          MENU.LOAD 53,19, 6,1,'A'
          MENU.LOAD 62,19, 8,1,'L'
          MENU.LOAD 73,19, 5,1,'S'
          MENU.LOAD  2,21, 4,1,'H'
          MENU.LOAD  9,21, 5,1,'P'
          MENU.LOAD 17,21, 8,1,'I'
          MENU.LOAD 27,21,11,3,'T'
          MENU.LOAD 41,21, 4,1,'F'
          MENU.LOAD 26,19, 2,1,'B'
          MENU.LOAD 48,21, 7,7,'Y'
          MENU.LOAD 57,21,10,1,'O'
          MENU.LOAD 69,21, 8,3,'G'
          MENU.LOAD 46,19, 4,1,'M'

          RETURN
*-------------------------------------------------------------------------*
SAVE.VNS: * If <ESC>, then save off the Vendor associations, else return.
          IF F12 OR NOT(VN.CHG) THEN RETURN TO START

          ANS = 'Y'
          PMT = 'Do You Wish To Keep The Vendor Associations? (Y/N) : '
IN$$14:   INP.PROMPT ANS,PMT,'YN',1
          IF NOT(ANS) THEN RETURN TO START

          ID.CT    = DCOUNT(IDS,AM)
          FOR IDX  = 1 TO ID.CT
             IF SKIPLN<IDX> THEN CONTINUE
             ID    = IDS<IDX>
             OID   = FIELD(ID,'~',3)
             LDID  = FIELD(ID,'~',4)
             PN    = PNS<IDX>
             VN    = VNS<IDX>
             ROQID = OID:'.':PN:'.':LDID

             *** If there's a VN then save it, else, make sure to delete
             *** an unused record.
             IF VN THEN
                WRITE VN ON ROQFILE,ROQID
             END ELSE
                DELETE ROQFILE,ROQID
             END
          NEXT IDX

          RETURN TO START
*-------------------------------------------------------------------------*
FINISH:   WINDOW.CLOSE
          RETURN
!TSMITH~11/16/17~11:25
